Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/graphics/peacoc/sampldll.frm

Text File | 1994-10-19 | 11KB | 443 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Color By Name"
   ClientHeight    =   4425
   ClientLeft      =   1440
   ClientTop       =   1980
   ClientWidth     =   5655
   Height          =   5115
   Icon            =   SAMPLDLL.FRX:0000
   Left            =   1380
   LinkTopic       =   "Form1"
   ScaleHeight     =   4425
   ScaleWidth      =   5655
   Top             =   1350
   Width           =   5775
   Begin ListBox List2
      Height          =   3930
      Left            =   2955
      TabIndex        =   1
      Top             =   300
      Width           =   2520
   End
   Begin ListBox List1
      BackColor       =   &H00FFFFFF&
      Height          =   3930
      Left            =   165
      TabIndex        =   0
      Top             =   285
      Width           =   2520
   End
   Begin CommonDialog CMDialog
      Left            =   2535
      Top             =   3525
   End
   Begin Label Label2
      Caption         =   "User Defined Colors"
      Height          =   255
      Left            =   2955
      TabIndex        =   3
      Top             =   45
      Width           =   2085
   End
   Begin Label Label1
      Caption         =   "Predefined Colors"
      Height          =   255
      Left            =   210
      TabIndex        =   2
      Top             =   45
      Width           =   2085
   End
   Begin Menu M_FILE
      Caption         =   "&File"
      Begin Menu M_EXIT
         Caption         =   "E&xit"
      End
   End
   Begin Menu M_EDIT
      Caption         =   "&Edit"
      Begin Menu M_ADD_COLOR
         Caption         =   "&Add Color"
      End
      Begin Menu M_CHANGE
         Caption         =   "&Change Color"
      End
      Begin Menu M_DELETE
         Caption         =   "&Delete Color"
      End
   End
   Begin Menu M_VIEW
      Caption         =   "&View"
      Begin Menu M_VIEW_COLOR
         Caption         =   "&Color Name"
         Begin Menu M_NAME_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_NAME_PRE
            Caption         =   "&Predefined"
         End
      End
      Begin Menu M_DETAIL
         Caption         =   "Color &Detail"
         Begin Menu M_COLOR_USER
            Caption         =   "&User Defined"
         End
         Begin Menu M_COLOR_PRE
            Caption         =   "&Predefined"
         End
      End
   End
End
Option Explicit

Sub Form_Load ()

  Dim winDir As String
  Dim infile As Integer
  Dim inline As String
  Dim pos As Integer
  Dim listString As String

  On Error GoTo ErrorEditRgb

  '
  ' get a list of the colors supported
  '
  listString = Space$(10 * 1024) ' 10 K

  cbnGetColorList listString, 10 * 1024

  ' find the double 0 at the end
  pos = InStr(listString, Chr$(0) + Chr$(0))
  ' leave one of the 0s for the end of the last string
  listString = Left$(listString, pos)

  pos = InStr(listString, Chr$(0))
  While pos <> 0
    List1.AddItem Mid$(listString, 1, pos - 1)
    listString = Mid$(listString, pos + 1, Len(listString))
    pos = InStr(listString, Chr$(0))
  Wend

  listString = Space$(10 * 1024)

  cbnGetUserColorList listString, 10 * 1024

  ' find the double 0 at the end
  pos = InStr(listString, Chr$(0) + Chr$(0))
  ' leave one of the 0s for the end of the last string
  listString = Left$(listString, pos)

  pos = InStr(listString, Chr$(0))
  While pos <> 0
    List2.AddItem Mid$(listString, 1, pos - 1)
    listString = Mid$(listString, pos + 1, Len(listString))
    pos = InStr(listString, Chr$(0))
  Wend

  '
  ' point the lists to the right place
  '
  If List1.ListCount <> 0 Then
    List1.ListIndex = 0
    List1_DblClick
  End If

  If List2.ListCount <> 0 Then
    List2.ListIndex = 0
    List2_DblClick
  End If

ErrorEditRgb:
  Exit Sub

End Sub

Sub List1_Click ()

  List1_DblClick

End Sub

Sub List1_DblClick ()

  Dim colorName As String
  Dim Color As Long

  colorName = List1.List(List1.ListIndex)

  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Color = cbnGetColor(colorName, CLng(List1.BackColor))
  List1.BackColor = Color

End Sub

Sub List2_Click ()

  List2_DblClick

End Sub

Sub List2_DblClick ()

  Dim colorName As String
  Dim Color As Long

  colorName = List2.List(List2.ListIndex)

  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  List2.BackColor = Color

End Sub

Sub M_ADD_COLOR_Click ()

  Dim colorName As String

  On Error GoTo ErrorHandler

  colorName = InputBox("Enter New Color Name:", "Color Name")
  If colorName = "" Then
    Exit Sub
  End If

   If cbnColorExists(colorName) = CBN_EXISTS And cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color " + colorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If

   If cbnUserColorExists(colorName) = CBN_EXISTS Then
    MsgBox "Error: User Color " + colorName + " already exists", 48, "Color Name Error"
    Exit Sub
  End If

  CMDialog.CancelError = True
  CMDialog.Flags = &H2&
  CMDialog.Action = 3
  cbnAddUserColor colorName, CLng(CMDialog.Color)
  List2.BackColor = CMDialog.Color
  List2.AddItem colorName
  List2.ListIndex = List2.NewIndex

ErrorHandler:
  ' user pressed the cancel button
  Exit Sub

End Sub

Sub M_CHANGE_Click ()

  Dim colorName As String
  Dim Color As Long
  Dim cnt As Integer

  On Error GoTo ErrorHandler2

  colorName = InputBox("Enter Color Name To Change:", "Color Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If

  If cbnColorExists(colorName) = CBN_EXISTS And cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: " + colorName + " is predefined - can only change user colors", 48, "Color Name Error"
    Exit Sub
  End If

  If cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: User Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  CMDialog.Color = Color
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3
  cbnAddUserColor colorName, CLng(CMDialog.Color)
  List2.BackColor = CMDialog.Color

  '
  ' find colorName in the list and set the index to it
  '
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = colorName Then
      List2.ListIndex = cnt
      Exit For
    End If
  Next

'
' Error handling here please
'
ErrorHandler2:
  ' user pressed the cancel button
  Exit Sub

End Sub

Sub M_COLOR_PRE_Click ()

  Dim colorName As String
  Dim Color As Long

  On Error GoTo ErrorHandlerColorPre

  colorName = InputBox("Enter Color Name To View:", "Color Name", List1.List(List1.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If

  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Color = cbnGetColor(colorName, CLng(List1.BackColor))
  List1.BackColor = Color
  CMDialog.Color = Color
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3

ErrorHandlerColorPre:
  ' user pressed the cancel button
  Exit Sub


End Sub

Sub M_COLOR_USER_Click ()

  Dim colorName As String
  Dim Color As Long

  On Error GoTo ErrorHandlerColorUser

  colorName = InputBox("Enter Color Name To View:", "Color Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If

  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  List2.BackColor = Color
  CMDialog.Color = Color
  CMDialog.CancelError = True
  CMDialog.Flags = &H2& Or &H1&
  CMDialog.Action = 3

ErrorHandlerColorUser:
  ' user pressed the cancel button
  Exit Sub


End Sub

Sub M_DELETE_Click ()

  Dim colorName As String
  Dim Color As Long
  Dim cnt As Integer

  On Error GoTo ErrorHandlerDelete

  colorName = InputBox("Enter Color Name To Delete:", "Color Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If

  If cbnColorExists(colorName) = CBN_EXISTS And cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: " + colorName + " is predefined - can only delete user colors", 48, "Color Name Error"
    Exit Sub
  End If

  If cbnUserColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: User Color " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  cbnDeleteUserColor colorName

  '
  ' find colorname in the user defined list and
  ' blow it away
  '
  For cnt = 0 To List2.ListCount
    If List2.List(cnt) = colorName Then
      List2.RemoveItem cnt
      Exit For
    End If
  Next

  List2.ListIndex = 0
  List2_Click

'
' Error handling here please
'
ErrorHandlerDelete:
  ' user pressed the cancel button
  Exit Sub

End Sub

Sub M_EXIT_Click ()

  End

End Sub

Sub M_NAME_PRE_Click ()

  Dim colorName As String
  Dim Color As Long

  colorName = InputBox("Enter Color Name to View:", "View Color By Name", List1.List(List1.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If

  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Color = cbnGetColor(colorName, CLng(List1.BackColor))
  List1.BackColor = Color

End Sub

Sub M_NAME_USER_Click ()

  Dim colorName As String
  Dim Color As Long

  colorName = InputBox("Enter Color Name to View:", "View Color By Name", List2.List(List2.ListIndex))
  If colorName = "" Then
    Exit Sub
  End If

  If cbnColorExists(colorName) = CBN_NOT_EXISTS Then
    MsgBox "Error: Color name " + colorName + " does not exist", 48, "Color Name Error"
    Exit Sub
  End If

  Color = cbnGetColor(colorName, CLng(List2.BackColor))
  List2.BackColor = Color

End Sub